home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / imb9101.zip / GETFILEN.BAS < prev    next >
BASIC Source File  |  1990-12-31  |  2KB  |  66 lines
  1. 'Program - - GETFILEN.BAS
  2. DECLARE FUNCTION ProgramName$ ()
  3. DEFINT A-Z
  4.  
  5. CONST FALSE = 0
  6. CONST TRUE = -1
  7.  
  8. 'PDS users should change the next line to include the QBX.BI file
  9. '$INCLUDE: 'QB.BI'
  10.  
  11. CLS
  12. PRINT "Program name = "; ProgramName$
  13. END
  14.  
  15. '=================== Function ProgramName$ ======================
  16. '== INPUT: None                                                ==
  17. '== RETURNS: Name of currently executing program               ==
  18. '================================================================
  19. '
  20. FUNCTION ProgramName$
  21.  
  22. DIM Regs AS RegType
  23.  
  24. 'Get PSP address
  25.  
  26.     Regs.ax = &H6200
  27.     CALL Interrupt(&H21, Regs, Regs)
  28.     PSPSegment = Regs.bx
  29.  
  30. 'Find environment address from PSP
  31.  
  32.     DEF SEG = PSPSegment
  33.     EnvSegment = PEEK(&H2D) * 256 + PEEK(&H2C)
  34.  
  35. 'Find the filename
  36.  
  37.     DEF SEG = EnvSegment
  38.     EOT = FALSE                 'Set end of environment table flag
  39.     Offset = 0
  40.  
  41.     WHILE NOT EOT
  42.         Byte = PEEK(Offset)       'Get table character
  43.         IF Byte = 0 THEN          'End of environment string?
  44. '     PRINT                   'Uncomment to print environment
  45.             Offset = Offset + 1
  46.             Byte = PEEK(Offset)
  47.             IF Byte = 0 THEN        'End of environment?
  48.                 Offset = Offset + 3   'Yes - Skip over nulls & tbl info
  49.                 C% = PEEK(Offset)
  50.                 WHILE C% <> 0                   'Assemble filename string
  51.                     FileN$ = FileN$ + CHR$(C%)    '  from individual
  52.                     Offset = Offset + 1           '  characters
  53.                     C% = PEEK(Offset)
  54.                 WEND
  55.                 EOT = TRUE              'Set flag to exit while/wend loop
  56.             END IF
  57.         ELSE                        'No-Read more environment string
  58. '     PRINT CHR$(Byte);         'Uncomment to print environment
  59.             Offset = Offset + 1
  60.         END IF
  61.     WEND
  62.     ProgramName$ = FileN$
  63.     DEF SEG
  64. END FUNCTION
  65.  
  66.